home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / sdklinemainmodule.bas < prev    next >
Encoding:
BASIC Source File  |  2006-03-06  |  6.8 KB  |  182 lines
  1. Attribute VB_Name = "SDKLineMainmodule"
  2. '******************************************************************'
  3. '*                                                                *'
  4. '*                      TurboCAD for Windows                      *'
  5. '*                   Copyright (c) 1993 - 2006                    *'
  6. '*             International Microcomputer Software, Inc.         *'
  7. '*                            (IMSI)                              *'
  8. '*                      All rights reserved.                      *'
  9. '*                                                                *'
  10. '******************************************************************'
  11. ' This sample demostrates how to use PointSnapped event
  12. Public m_theToolEvents  As IToolEvents
  13. Public m_iConnectId  As Long
  14. Public m_bRun() As Boolean
  15. Public m_tcApp  As Application
  16. Public m_ptcTool As Tool
  17. Public T As tcEventsHandler
  18. Public m_ActiveTool As SDKLineTools
  19. Public m_lLineColor As Long
  20. Public ghHook As Long
  21.  
  22. Const NUM_LMITEMS = 2
  23.  
  24. Enum SDKLineTools
  25.    SDKLine = 0
  26.    SDKPolyline = 1
  27. End Enum
  28. Public Enum ToolStatus
  29.    iStarted = 0
  30.    iFirstClick = 1
  31.    iSecondClick = 2
  32. End Enum
  33. Type POINTAPI
  34.     X As Long
  35.     Y As Long
  36. End Type
  37. Public Const WH_KEYBOARD = 2
  38. Public Const VK_SHIFT = &H10
  39. Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
  40. Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
  41. Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
  42. Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  43.  
  44. Public Const NULL_BRUSH = 5
  45. Public Const R2_XORPEN = 7
  46.  
  47. Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
  48. Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  49. Public Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
  50. Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  51. Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  52. Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  53. Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  54. Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  55. Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  56. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  57. Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  58. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  59.  
  60.  
  61.  
  62. Public Function KeyboardProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  63.     'if idHook is less than zero, no further processing is required
  64.     'MsgBox "idHook " & idHook
  65.     If idHook < 0 Then
  66.         'call the next hook
  67.         KeyboardProc = CallNextHookEx(ghHook, idHook, wParam, ByVal lParam)
  68.     Else
  69.         'check if SHIFT-S is pressed
  70.         'If (GetKeyState(VK_SHIFT) And &HF0000000) And wParam = asc("S") Then
  71.         '    'show the result
  72.         '    Form1.Print "Shift-S pressed ..."
  73.         'End If
  74.         'MsgBox "wParam= " & CStr(wParam) & " asc(Enter) = " & Asc("ENTER") & " lParams = " & lParams
  75.         MsgBox "Entered into hook wParam = " & wParam
  76.         
  77.         If (wParam = Asc("TAB") Or wParam = Asc("ENTER")) Then
  78.             ' probably values in edit bar for our tool are changed
  79.             MsgBox "value is changed"
  80.         End If
  81.         
  82.         'call the next hook
  83.         KeyboardProc = CallNextHookEx(ghHook, idHook, wParam, ByVal lParam)
  84.     End If
  85. End Function
  86.  
  87. Public Sub SDKLineToolAddInspectorBarFields(ByVal bAdd As Boolean)
  88.     
  89.     Dim gxProps As Properties
  90.     Dim gxProp As Property
  91.     
  92.     Dim nProps As Long
  93.     Dim lFlags As Long
  94.     Dim pxdbTool As IToolEvents
  95.     On Error GoTo ErrorHandler
  96.     Set gxProps = m_ptcTool.Properties
  97.  
  98.     If bAdd = True Then
  99.         nProps = gxProps.Count
  100.         If nProps = 0 Then
  101.             With gxProps
  102.                 .Add "Prop 1", 0, 0, 1
  103.                 .Add "Prop 2", 0, 0, 2
  104.                 .Add "Prop 3", 0, 0, 3
  105.             End With
  106.         Else
  107.         End If
  108.     End If
  109.     If bAdd = True Then
  110.         lFlags = 1
  111.     Else
  112.         lFlags = 2
  113.     End If
  114.     Set pxdbTool = m_ptcTool.Application.ToolEvents
  115.     pxdbTool.ToolChangeProperties m_ptcTool, lFlags
  116.     Set pxdbTool = Nothing
  117.     If bAdd = True And ghHook = 0 Then
  118.         'ghHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, App.ThreadID)
  119.     Else
  120.         UnhookWindowsHookEx ghHook
  121.         ghHook = 0
  122.     End If
  123.     'Set gxProps = Nothing
  124.     Exit Sub
  125. ErrorHandler:
  126.     MsgBox "AddInspectorBarFields sub failed " & Err.Description
  127.     Err.Clear
  128.     Set gxProps = Nothing
  129.     Set pxdbTool = Nothing
  130.     
  131. End Sub
  132.  
  133. Public Function SDKLineToolAddLocalMenu(bAddItems As Boolean)
  134.     On Error GoTo ErrorHandler
  135.     Dim MenuCaptions(NUM_LMITEMS) As String
  136.     Dim StatusPrompts(NUM_LMITEMS) As String
  137.     Dim Enabled(NUM_LMITEMS) As Boolean
  138.     Dim Checked(NUM_LMITEMS) As Boolean
  139.     Dim varCaptions As Variant
  140.     Dim varPrompts As Variant
  141.     Dim varEnabled As Variant
  142.     Dim varChecked As Variant
  143.     If m_theToolEvents Is Nothing Then
  144.         Exit Function
  145.     End If
  146.     If (bAddItems = True) Then
  147.         ' fill array of local menu items
  148.         MenuCaptions(0) = "Add InspectorBar fields"
  149.         StatusPrompts(0) = "Add the inspector bar fields for the tool"
  150.         Enabled(0) = True
  151.         Checked(0) = False
  152.         MenuCaptions(1) = "Remove InspectorBar fields"
  153.         StatusPrompts(1) = "Remove InspectorBar fields"
  154.         Enabled(1) = True
  155.         If b_ToolMode = 1 Then
  156.             Checked(1) = True
  157.         Else
  158.             Checked(1) = False
  159.         End If
  160.         
  161.         MenuCaptions(2) = "SDK Line Finish"
  162.         StatusPrompts(2) = "SDK Line Finish"
  163.         Enabled(2) = True
  164.         Checked(2) = False
  165.         
  166.         varCaptions = MenuCaptions
  167.         varPrompts = StatusPrompts
  168.         varEnabled = Enabled
  169.         varChecked = Checked
  170.         m_theToolEvents.ToolChangeCommands T, 3, varCaptions, varPrompts, varEnabled, varChecked, True
  171.      
  172.     Else
  173.         ' remove items from tool's local menu
  174.         m_theToolEvents.ToolChangeCommands T, 0, , , , , False
  175.     End If
  176.     Exit Function
  177. ErrorHandler:
  178.     MsgBox "AddLocalMenu function failed " & Err.Description
  179.  
  180. End Function
  181.  
  182.